home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tutil.arc / WINDOW.INC < prev   
Encoding:
Text File  |  1985-03-06  |  3.7 KB  |  149 lines
  1. { Turbo Pascal removable window system                }
  2. { Copyright 1984 Michael A. Covington                 }
  3. { PC Tech Journal - Vol 3, #2. February 1985, Pg.121  }
  4.  
  5. { Modifications by David J. Smith, February, 1985     }
  6.  
  7. { Requirements: IBM PC or close compatible.  Screen   }
  8. { must be in text mode, on page 1, either mono or     }
  9. { color card.                                         }
  10.  
  11. { NOTE - Call INITWIN before calling MKWIN or RMWIN.  }
  12.  
  13.  
  14. Const
  15.   _Maxwin = 4;      { Maximum number of window open at once }
  16.  
  17. type
  18.   _imagetype  = array [1..4096] of char;
  19.   _windimtype = record
  20.                  x1, y1, x2, y2: integer
  21.                end;  {windimtype}
  22.  
  23. var
  24.   _win:  { Global variable package }
  25.     record
  26.       dim:    _windimtype;  {current window dimensions }
  27.       depth:  integer;
  28.       stack:  array[1.._maxwin] of
  29.         record
  30.           image: _imagetype;  {Saved screen image     }
  31.           dim:   _windimtype; {Saved window dimensions}
  32.           x, y:  integer     {Saved cursor position  }
  33.         end
  34.     end;
  35.   _crtmode:     byte       absolute $0040:$0049;
  36.   _crtwidth:    byte       absolute $0040:$004A;
  37.   _monobuffer:  _imagetype absolute $B000:$0000;
  38.   _colorbuffer: _imagetype absolute $B800:$0000;
  39.  
  40.  
  41. procedure initwin;
  42.   { Records initial window dimensions }
  43.  
  44. begin
  45.   with _win.dim do
  46.     begin x1:=1; y1:=1; x2:=_crtwidth; y2:=25
  47.   end;
  48.   _win.depth:=0
  49. end;  {initwin}
  50.  
  51.  
  52. procedure boxwin(x1, y1, x2, y2: integer);
  53.   { Draws a box, fills it with blanks, and makes it the current window.  }
  54.   { Dimensions geven are for the box; actual window is one unit          }
  55.   { smaller in each direction.  This routine can be used separately      }
  56.   { from the rest of the removeable window package.                      }
  57.  
  58. var
  59.   loop: integer;
  60.  
  61. begin
  62.   window(1,1,80,25);
  63.  
  64.   { Top }
  65.   gotoxy(x1, y1);
  66.   write(chr(213));
  67.   for loop:=x1+1 to x2-1 do write(chr(205));
  68.   write(chr(184));
  69.  
  70.   { Sides }
  71.   For loop:=y1+1 to y2-1 do
  72.     begin
  73.       gotoxy(x1,loop);
  74.       write(chr(179));
  75.       gotoxy(x2,loop);
  76.       write(chr(179));
  77.     end;
  78.  
  79.   { Bottom }
  80.   gotoxy(x1, y2);
  81.   write(chr(212));
  82.   for loop:=x1+1 to x2-1 do write(chr(205));
  83.   write (chr(190));
  84.  
  85.   { Make it the current window }
  86.   window(x1+1, y1+1, x2-1, y2-1);
  87.   clrscr;
  88.   gotoxy(1, 1)
  89. end;  {Boxwin}
  90.  
  91.  
  92. procedure mkwin(x1, y1, x2, y2: integer);
  93.   { Create a removeable window }
  94.  
  95. begin
  96.   { Increment stack pointer }
  97.   with _win do depth:=depth+1;
  98.   if _win.depth>_maxwin then
  99.     begin
  100.       writeln(^G,'Windows nested too deep ');
  101.       halt
  102.     end;
  103.  
  104.   { Save contents of screen }
  105.   if _crtmode = 7 then
  106.     _win.stack[_win.depth].image := _monobuffer
  107.   else
  108.     _win.stack[_win.depth].image := _colorbuffer;
  109.  
  110.   _win.stack[_win.depth].dim := _win.dim;
  111.   _win.stack[_win.depth].x   := wherex;
  112.   _win.stack[_win.depth].y   := wherey;
  113.  
  114.   { Create window }
  115.   boxwin(x1,y1,x2,y2);
  116.   _win.dim.x1 := x1+1;
  117.   _win.dim.y1 := y1+1;  { Allow for margins }
  118.   _win.dim.x2 := x2-1;
  119.   _win.dim.y2 := y2-1;
  120. end;  {mkwin}
  121.  
  122.  
  123. procedure rmwin;
  124.   { Remove the most recently created removable window }
  125.   { Restore the screen contents, window dimensions,   }
  126.   { and position of the cursor.                       }
  127.  
  128. begin
  129. if _win.depth > 0 then
  130.   with _win do
  131.     begin
  132.       if _crtmode = 7 then
  133.         _monobuffer := stack[depth].image
  134.       else
  135.         _colorbuffer := stack[depth].image;
  136.       dim := stack[depth].dim;
  137.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  138.       gotoxy(stack[depth].x,stack[depth].y);
  139.       depth := depth - 1
  140.     end {with}
  141.   else
  142.     writeln(^g' No More Windows to remove ')
  143.   end; {rmwin}
  144.  
  145.  
  146.  
  147.  
  148. {EOF}
  149.